home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 41.zip / BS1 part 41 / Amiga Plus 1.adf / Programming / mastermind (.txt) < prev    next >
Encoding:
AmigaBASIC Source Code  |  1978-04-08  |  6.0 KB  |  258 lines
  1. MAIN:
  2.     GOSUB Instruct
  3.     GOSUB InitGame
  4.     GOSUB MakeBoard
  5.     GOSUB MakeColorBoxes
  6.     GOSUB MakeReadyBox
  7.     GOSUB GetAnswer
  8.     GOSUB  StartGame
  9.   
  10.  
  11. StartGame:  
  12.     BREAK ON
  13.     MENU ON
  14.     Row=1
  15.     ap=0 :fflag=0
  16.     X=MOUSE(0)
  17.     GOTO MouseHandler
  18.     RETURN
  19.                                                           
  20. MakeBoard:
  21.   SCREEN 2,320,200,4,1
  22.   WINDOW 2,"     Master Mind ",(0,4)-(311,186),16,2  
  23.   PALETTE 0,1,0.933333,0.86667 
  24.   PALETTE 1,0.8,0.6666,0.6666 
  25.   PALETTE 2,0,0,0 'Black
  26.   PALETTE 3,1,1,1 'White  
  27.   PALETTE 4,1,1,0 
  28.   PALETTE 5,0.133,0.133,1 
  29.   PALETTE 6,1,0.5333,0 
  30.   PALETTE 7,0.133,0.733,0.133 
  31.   PALETTE 8,1,0.0666,0.0666
  32.   PALETTE 9,0.7333,0,1 
  33.   PALETTE 10,0.4,0.3333,0.3333 
  34.   PALETTE 11,0.7333,0.8,1 
  35.   PALETTE 14,0.1333,0.3333,0.8666
  36.   Blank=10
  37.   Top=10:Bottom=175
  38.   Right=211:Left=100
  39. ClearBoard:  
  40.   LOCATE 3,29: COLOR 0,0
  41.   PRINT "           ";:COLOR 1,0
  42.   LINE (Left,Top)-(Right,Bottom),1,bf
  43.   LINE (Left-1,Top-1)-(Right+1,Bottom+1),2,b
  44.   LINE (Left+78,Top+23)-(Right-6,Bottom-6),2,b
  45.   FOR R=1 TO 8
  46.    bb=Bottom-6-(17*R)
  47.    LINE (Left+78,bb)-(Right-6,bb),2
  48.   NEXT R
  49.   LINE (Left+6,Top+14)-(Left+74,Top+24),Blank,bf
  50.   LINE (Left+6,Top+14)-(Left+74,Top+24),14,b
  51.    FOR R=1 TO 8
  52.     FOR c=0 TO 3
  53.      FillSpot R,c,Blank
  54.     NEXT c
  55.    NEXT R  
  56. MakeBoardDone: RETURN
  57.    
  58. MakeColorBoxes:
  59.   ClrRgt=90:ClrLft=10:ClrBt=180
  60.   LINE (ClrLft,0)-(ClrRgt,ClrBt),2,b
  61.   FOR c=1 TO 6
  62.    Tp=30*(c-1)
  63.    LINE (ClrLft,Tp)-(ClrRgt,Tp+30),c+3,bf
  64.    LINE (ClrLft,Tp)-(ClrRgt,Tp+30),2,b
  65.   NEXT c
  66. MakeColorBoxesDone: RETURN
  67.  
  68. MakeReadyBox:
  69.   RLft=250:rrgt=300
  70.   RTp=75:RBt=125
  71.   LINE (RLft,RTp)-(rrgt,RBt),2,bf
  72.   LINE (RLft+4,RTp+4)-(rrgt-4,RBt-4),11,bf
  73.   LOCATE 13,33:COLOR 2,11
  74.   PRINT  "Ready"
  75. MakeReadyBoxDone:RETURN
  76.   
  77. closeup:
  78.   WINDOW CLOSE 2
  79.   SCREEN CLOSE 2
  80.   MENU RESET
  81.   SYSTEM
  82. CloseUpDone:RETURN 
  83.  
  84. InitGame:
  85.   DEFINT a-Z
  86.   DIM Guess(3),Answer(3)
  87.   ON BREAK GOSUB closeup
  88.   MENU 1,0,1,"MasterMind"
  89.   MENU 1,1,1,"  New Game "
  90.   MENU 1,2,1,"   Peek    " 
  91.   MENU 1,3,1,"  Give Up  "
  92.   MENU 1,4,1,"   Quit    "
  93.   ON MENU GOSUB MenuHandler
  94. InitGameDone: RETURN
  95.   
  96. MenuHandler:
  97.   Item=MENU(1)
  98.   ON Item GOTO NewGame,APeek,ShowAnswer,closeup
  99.   
  100. NewGame:
  101.   Row=1
  102.   ap=0 :fflag=0
  103.   GOSUB GetAnswer
  104.   GOSUB ClearBoard
  105. NewGameDone: RETURN MouseHandler
  106.  
  107. APeek:
  108.   IF ap>3 THEN ap=3
  109.   FillSpot 9,ap,Answer(ap)
  110.   ap=ap+1
  111. APeekDone: RETURN  
  112.    
  113. MouseHandler:
  114.   WHILE MOUSE(0)=0
  115.   WEND
  116.   X=MOUSE(3):y=MOUSE(4)
  117.   IF X<=ClrRgt THEN PickColor 
  118.   IF X<=Right-33 AND X>=Left+6 THEN MakeGuess
  119.   IF X>=RLft AND y<=RBt AND y=>RTp THEN GuessReady
  120. MouseHandlerDone:GOTO MouseHandler
  121.                                         
  122.  
  123. PickColor:
  124.   CurrClr=4+FIX(y/30)
  125.   Newclr=1
  126. PickColorDone:  GOTO MouseHandler
  127.  
  128. MakeGuess: 
  129.   Colm=FIX((X-Left-6)/18)
  130.   Guess(Colm)=CurrClr
  131.   FillSpot Row,Colm,CurrClr
  132. MakeGuessDone: GOTO MouseHandler
  133.  
  134. GetAnswer: RANDOMIZE TIMER
  135.   FOR i=0 TO 3
  136. R:    Answer(i)=4+FIX(6*RND)
  137.       FOR j=i-1 TO 0 STEP -1
  138.         IF Answer(i)=Answer(j) THEN R
  139.       NEXT j
  140.   NEXT i
  141. GetAnswerDone: RETURN           
  142.   
  143.   
  144. MarkGuess:
  145.   Place=0:Colr=0:j=0
  146.   FOR i=0 TO 3
  147.     WHILE j<4
  148.      IF Answer(i)=Guess(i) THEN
  149.            Place=Place+1
  150.            GOTO iLoop
  151.      ELSEIF Answer(i)=Guess(j) THEN
  152.            Colr=Colr+1
  153.            GOTO iLoop
  154.      END IF  
  155.      j=j+1
  156.     WEND
  157. iLoop:j=0:NEXT i
  158.    FOR i=0 TO 3
  159.      Guess(i)=Blank
  160.    NEXT i  
  161. MarkGuessDone:RETURN
  162.  
  163. GuessReady:
  164.  GOSUB MarkGuess
  165.  IF Newclr=1 THEN Row=Row+1 
  166.  Newclr=0:R=Row-1
  167.  ShowScore Place,Colr,R
  168.  IF Place=4 OR Row>8 THEN Finished
  169. GuessReadyDone: GOTO MouseHandler
  170.  
  171. Finished: fflag=1
  172.     ShowScore pl,cl,Row
  173.     LOCATE 3,29:COLOR 10,0
  174.     BEEP 
  175.     IF Place<4 THEN PRINT  "  Sorry    " :ELSE PRINT  "You Win!"
  176. ShowAnswer:    AnswRow=9
  177.     FOR i=0 TO 3
  178.       FillSpot AnswRow,i,Answer(i)
  179.     NEXT i
  180.     IF fflag THEN MouseHandler
  181.     RETURN
  182.     
  183. Instruct:
  184.   WINDOW 2,"        MasterMind",,20
  185.   CLS                                                                
  186.   PRINT :PRINT 
  187.   PRINT "     The game of Mastermind tests your powers of analytic deduction."
  188.   PRINT "  The object of this game is to determine the random combination"
  189.   PRINT "  of 4 different colors (out of 6) chosen by the computer.  Make "
  190.   PRINT "  your guess by selecting a color from the column at the left with the"
  191.   PRINT "  mouse then clicking on a position on the lowest row of the game board to"
  192.   PRINT "  fill.  Select a new color and continue to fill spots until your"
  193.   PRINT "  guess is finished. Be sure to check that the guess is a good "
  194.   PRINT "  one... no mistakes, duplicate colors or repeat guesses. Remember
  195.   PRINT "  you can change a guess by refilling it. When you are ready select"
  196.   PRINT "  READY.  The computer will mark your guess by placing one black"
  197.   PRINT "  square in the box beside your guess for every color which is in"
  198.   PRINT "  the right spot and one white square for every color which occurs"
  199.   PRINT "  in the answer but is not in the right place. Thus the lowest possible"
  200.   PRINT "  score for a guess with 4 different colors in it is 2 whites
  201.   PRINT "  while the highest score (correct answer) is 4 blacks.
  202.   PRINT "  "
  203.   PRINT "     A good general strategy is to first determine the 4 colors"
  204.   PRINT "  while varying the positions in order to gain information for "
  205.   PRINT "  later use in determining the positions."
  206.   PRINT "  "
  207.   t=MOUSE(0)
  208.   PRINT "    Click mouse to start!"
  209.   WHILE  NOT MOUSE(0)
  210.   WEND
  211.   WINDOW CLOSE 2
  212.  InstructDone:RETURN  
  213.   
  214.      
  215. SUB ShowScore(pl,cl,Rw) STATIC
  216.     SHARED Bottom,Left
  217.     MENU OFF
  218.     t=Bottom-6-17*Rw
  219.     l=Left+78
  220.     spot=1:PPen=2:CPen=3
  221.     FOR s=1 TO pl
  222.      IF spot>2 THEN down=10 :ELSE down=2
  223.      IF spot/2=FIX(spot/2) THEN over =16 :ELSE over =4
  224.      IF spot<5 THEN LINE (l+over,t+down)-STEP (6,4),PPen,bf
  225.      spot=spot+1
  226.     NEXT s
  227.     FOR s=1 TO cl
  228.      IF spot>2 THEN down=10 :ELSE down=2
  229.      IF spot/2=FIX(spot/2) THEN over =16 :ELSE over =4
  230.      IF spot<5 THEN LINE (l+over,t+down)-STEP (6,4),CPen,bf
  231.      spot=spot+1
  232.     NEXT s
  233.     MENU ON
  234.  END SUB
  235.     
  236. SUB FillSpot(Rw,cl,Clr) STATIC
  237.     SHARED Bottom,Left
  238.      MENU OFF
  239.      cx=cl*16+14+Left
  240.      Brdr=2
  241.      cy=Bottom-10-((Rw-1)*17)   
  242.    '  CIRCLE (cx,cy),4,Brdr  '   the cicrles looked better but were
  243.    ' PAINT (cx,cy),Clr,Brdr  '   quite slow, try it and see!
  244.      LINE (cx+4,cy+4)-(cx-4,cy-4),Brdr,b
  245.      LINE (cx+3,cy+3)-(cx-3,cy-3),Clr,bf
  246.      MENU ON
  247. END SUB        
  248.   
  249.   
  250.   
  251.   
  252.  
  253.   
  254.   
  255.    
  256.  
  257.   
  258.